home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / rbbs_pc / disring7.zip / DISRNG74.MRG < prev   
Text File  |  1992-07-01  |  15KB  |  269 lines
  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against rbbssub2.bas to produce rbbs1742.bas
  3. * rbbssub2.bas:  Date 6-20-1992  Size 140946 bytes
  4. * ------------[ Created 07-01-1992 09:40:10 ]------------
  5. * REPLACING old line(s) by new
  6. ' $linesize:132
  7. ' $title: 'RBBSSUB2.BAS 17.4, Copyright 1986 - 92 by D. Thomas Mack'
  8. '  Copyright 1991 by D. Thomas Mack, all rights reserved.
  9. '  Name ...............: RBBSSUB2.BAS
  10. '  First Released .....: June 21, 1992
  11. '  Subsequent Releases.: 
  12. '  Copyright ..........: 1986 - 1992
  13. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  14. '     RBBS-PC.BAS utilizes a lot of common subroutines.  Those that do not
  15. '     require error trapping are incorporated within RBBSSUB 2-5 as
  16. '     separately callable subroutines in order to free up as much
  17. '     code as possible within the 64K code segment used by RBBS-PC.BAS.
  18. '  Parameters..........: Most parameters are passed via a COMMON statement.
  19. '
  20. ' Subroutine  Line               Function of Subroutine
  21. '   Name     Number
  22. '  Macro          1320  Check/execute macro
  23. '  AnswerIt        200  Answer the telephone when it rings
  24. '  ASCIICodes      129  Allow a CONFIG string to have any ASCII value
  25. '  BadChar         455  Check user name for invalid characters
  26. '  BadName       20235  Check for system crash attempt with bad file name
  27. '  BankTime       5500  Let caller change banked time
  28. '  CheckRatio    20096  Test upload/download ratio
  29. '  CheckMacro     1242  Checks for macro and processes
  30. '  CopyRight        97  Display RBBS-PC's copyright notice
  31. '  DEFALTU        9600  Write out the user's defaults
  32. '  DenyAccess     1386  Downgrade security so access denied
  33. '  DoorExit      10983  Set up a .BAT file to exit RBBS-PC to a "door"
  34. '  DoorInfo      10991  Writes out information for a door
  35. '  DosExit       10934  Set up a .BAT file to exit to DOS (second level)
  36. '  EditALine      2618  Edits a single line
  37. '  EditDef         120  Edit configuration parameters
  38. '  FileNameCheck 20240  Matches file name to a prefix & extension
  39. '  GetArc        20140  Handle request for verbose listing
  40. '  GetCommand      101  Get RBBS-PC's node id from command line
  41. '  GetTime        9140  Calculates callers elapsed time (hh,mm,ss)
  42. '  GoIdle           90  Release resources when waiting for keyboard input
  43. '  KillMsg        3952  Delete old or unnecessary messages
  44. '  Line25          945  Build and/or update line 25 of RBBS-PC's local screen
  45. '  LineEdit       3700  Edit a line while minimizing string space consumption
  46. '  LogError      13660  Log error message to CALLERS file
  47. '  LPrnt          1480  Subroutine to write to local display
  48. '  MLInit            8  Handle MultiLink initialization/de-initialization
  49. '  MsgProt        2055  Sets protection for a message
  50. '  ParseIt        1637  Parses a string
  51. '  PassWrd         660  Verify user & message passwords
  52. '  PopCmdStack    1650  Get user input, 1st checking command stack
  53. '  PScrn          1483  Print to display
  54. '  QuickLPrnt     1482  Quickly writes count of blocks on file transfer
  55. '  QuickTPut      1478  Fast, but limited, "TPut" equivalent
  56. '  QuickTPut1     1478  Outputs short string following by CR LF
  57. '  RBBSExit      10992  RBBS-PC exit to transfer control to other programs
  58. '  RecoverMsg    10410  Recover a deleted message
  59. '  RemNonAlf      5100  Removes non-alpha characters from a string
  60. '  RingCaller     1636  Ring caller's bell and put message in emphasis
  61. '  SetBaud        1654  Set baud rate in the 8250 chip of the RS232 interface
  62. '  SetCrLf        1496  Set up the necessary carriage return/line feed string
  63. '  SetSection    12000  Set the proper section prompts (main, file, util, libr)
  64. '  SetThread      4554  Set up request for threading thru messages
  65. '  SetWhoTo       2018  Sets who a message/personal upload is to
  66. '  SkipLine       1485  Write a # of blank lines to the communications port
  67. '  SearchCmd      1238  Searches list of commands in RBBS for a request
  68. '  SecViolation   1380  Process a security violation
  69. '  SysMenu         112  Displays sysop menu/status
  70. '  SysopChat      4773  Sysop and caller chat
  71. '  TestRel         336  Tests for Reliable connect
  72. '  TGet           1498  Read a line from the communications port
  73. '  TPut           1396  Write a line to the communications port
  74. '  Trim            105  Strip leading and trailing blanks from a string
  75. '  TrimTrail       107  Strip off specified string off end of another string
  76. '  UntilRight    12878  Ask a question until user says answer is right
  77. '  UpdateU       10600  Updates the user record on loging off/exiting RBBS-PC
  78. '  VarInit         109  Initialize system variables
  79. '  ViewHelp       1330  Processes help command
  80. '  WhoCheck       2250  Checks whether a user exists in user file
  81. '  WhosOn         9801  Report status of each node - who's on
  82. '  WordInFile    10976  Find a whole word within a file/menu
  83. '
  84. * ------[ first line different ]------
  85. '  PersonalRing         Detects "Distinctive Ring" patterns from Phone Co.
  86. '                                                                    ' JR070101
  87. '  $INCLUDE: 'RBBS-VAR.BAS'
  88. '
  89. '  $SUBTITLE: 'MLInit - MultiLink initialization/deinitialization'
  90. '  $PAGE
  91. '
  92. '  NAME    -- MLInit
  93. '
  94. '  INPUTS  --  MLParm = 1             INITIALIZE AT STARTUP OR RE-
  95. '                                     CYLCE TIME
  96. '              MLParm = 2             DE-INITIALIZE ON EXITING TO
  97. '                                     A DOOR OR DOS REMOTELY
  98. '              MLParm = 3             DE-QUEUE COMMUNICATIONS PORTS
  99. '              MLParm = 4             CHECK FOR MULTILINK PRESENT
  100. '              ZDoorsTermType
  101. '              ZBaudTest!
  102. '              ZComPort$
  103. '              ZComputerType
  104. '
  105. '  OUTPUTS --  NONE
  106. '
  107. '  PURPOSE --  To test for the presence of multi-link and set
  108. '              multi link options to be compatible with RBBS-PC
  109. '
  110.       SUB MLInit (MLParm) STATIC
  111.     DEF SEG = 0
  112.     IF ZComputerType = 1 _
  113.        GOTO 10
  114.     IF NOT ZMLCom THEN _
  115.        IF ZNetworkType <> 1 THEN _
  116.           GOTO 10
  117.     ZMultiLinkPresent = PEEK(&H1FE) + 256 * PEEK(&H1FF)
  118.     IF ZMultiLinkPresent = 0 THEN _
  119.        GOTO 10
  120.     ON MLParm GOSUB 30,20,60,10
  121. * REPLACING old line(s) by new
  122. 237 LOCATE 18,76
  123.     IF ZDosANSI THEN _
  124.        CALL LPrnt(ZEscape$ + "[05m" + "YES" + ZEscape$ + "[00m",0) _
  125.     ELSE CALL LPrnt ("YES",0)
  126.     COLOR ZFG,ZBG,ZBorder
  127.     LOCATE 20,56
  128. '
  129. '
  130. ' *  GET READY TO ANSWER INCOMMING CALL:
  131. ' *       1.  LET THE MODEM "AUTO-ANSWER" FOR RBBS-PC.
  132. ' *           REQUIRED RINGS = 0 AND S0 = 1 IN MODEM INIT COMMAND.
  133. ' *       2.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS.
  134. ' *           REQUIRED RINGS > 0 AND S0 = 254 IN MODEM Init COMMAND.
  135. ' *       3.  ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS AFTER A USER
  136. ' *           First CALLS AND THEN HANGS UP (I.E. RING-BACK).
  137. ' *           REQUIRED RINGS > 0 AND S0 = 255 IN MODEM INIT COMMAND.
  138. '
  139. '
  140.     WasQQ = 255
  141.     WasI = INSTR(ZModemInitCmd$,"S0")
  142.     IF WasI = 0 THEN _
  143.        GOTO 239
  144. * ------[ first line different ]------
  145.     Sreg% = VAL(MID$(ZModemInitCmd$,WasI + 3,3))                     ' JR070102
  146.     IF Sreg% = 255 THEN                                              ' JR070103
  147.        WasQQ = 0 : _                                                 ' JR070104
  148.        ZBlk = WasQQ                                                  ' JR070105
  149.     END IF                                                           ' JR070106
  150.     ZSecsUsedSession! = TIMER
  151.     ZSubParm = 1
  152.     CALL Line25
  153.     RingAnswer = ZTrue
  154.     IF RingBack THEN _
  155.        RingAnswer = ZFalse
  156. * REPLACING old line(s) by new
  157. 266    IF (INP(ZModemStatusReg) AND &H40) > 0 AND _
  158. * ------[ first line different ]------
  159.           ZRequiredRings > 0 THEN                                    ' JR070107
  160.              IF Sreg% = 252 OR Sreg% = 253 THEN                      ' JR070108
  161.                 PAnswer% = 0                                         ' JR070109
  162.                 CALL PersonalRing(PAnswer%, Sreg%)                   ' JR070110
  163.                    IF PAnswer% = 1 THEN                              ' JR070111
  164.                       GOTO 276                                       ' JR070112
  165.                    END IF                                            ' JR070113
  166.              ELSE                                                    ' JR070114
  167.                 GOTO 276
  168.              END IF                                                  ' JR070115
  169.        END IF                                                        ' JR070116
  170. * REPLACING old line(s) by new
  171. 270    IF ZRecycleWait > 0 THEN _
  172.           CALL CheckTime(InactiveDelay!, TempElapsed!, 1) : _
  173.           IF TempElapsed! <= 0 THEN _
  174.              ZSubParm = 8 : _
  175.              EXIT SUB
  176. * ------[ first line different ]------
  177.        IF Sreg% = 252 OR Sreg% = 253 THEN                            ' JR070117
  178.           IF PAnswer% = 0 THEN                                       ' JR070118
  179.              CALL GoIdle                                             ' JR070119
  180.              GOTO 247                                                ' JR070120
  181.           ELSE                                                       ' JR070121
  182.              GOTO 276                                                ' JR070122
  183.           END IF                                                     ' JR070123
  184.        END IF                                                        ' JR070124
  185.        CALL FlushCom (WasX$)
  186.        IF LEN(WasX$) > 0 THEN _
  187.           ModemResponse$ = ModemResponse$ + WasX$ : _
  188.           RingDetected = (INSTR(ModemResponse$,"RING") > 0) : _
  189.           ConnectDetected = (INSTR(ModemResponse$,"ONNECT") > 0) : _
  190.           NoCall = (NOT RingDetected) AND (NOT ConnectDetected)
  191.     IF RingDetected AND ZRequiredRings > 0 THEN _
  192.        MID$(ModemResponse$, INSTR(ModemResponse$,"RING")+1,1) = "A" : _
  193.        RingDetected = ZFalse : _
  194.        GOTO 276
  195.     CALL GoIdle
  196.     GOTO 247
  197. * REPLACING old line(s) by new
  198. 20246 IF BaudTest! = 14400 THEN _
  199.          BPS = -9 _
  200.       ELSE IF BaudTest! = 16800 THEN _
  201.          BPS = -10 _
  202.       ELSE IF BaudTest! = 7200 THEN _
  203.          BPS = -6 _
  204.       ELSE IF BaudTest! = 12000 THEN _
  205.          BPS = -8 _
  206.       ELSE BPS = -7       ' 9600
  207.       END SUB
  208. * ------[ first line different ]------
  209.  
  210. DEFINT A-Z                                                           ' JR070125
  211. SUB PersonalRing (PAnswer%, Sreg%) STATIC                            ' JR070126
  212.  
  213.    LOCATE 20, 36                                                     ' JR070127
  214.    PRINT "PERSONAL RING"                                             ' JR070128
  215.  
  216.    ptimeout! = TIMER                                                 ' JR070129
  217.    DO                                                                ' JR070130
  218.       DetectedRing% = INP(ZModemStatusReg) AND &H40                  ' JR070131
  219.       ptimeend! = TIMER                                              ' JR070132
  220.       IF ptimeend! - ptimeout! > 5 THEN                              ' JR070133
  221.          LOCATE 20, 36                                               ' JR070134
  222.          PRINT "             "                                       ' JR070135
  223.          EXIT SUB                                                    ' JR070136
  224.       END IF                                                         ' JR070137
  225.    LOOP UNTIL DetectedRing% = 0                                      ' JR070138
  226.  
  227.       ptimeout! = TIMER                                              ' JR070139
  228.       DO                                                             ' JR070140
  229.          DetectedRing% = INP(ZModemStatusReg) AND &H40               ' JR070141
  230.          ptimeend! = TIMER                                           ' JR070142
  231.          IF ptimeend! - ptimeout! > 5 THEN                           ' JR070143
  232.             LOCATE 20, 36                                            ' JR070144
  233.             PRINT "             "                                    ' JR070145
  234.             EXIT SUB                                                 ' JR070146
  235.          END IF                                                      ' JR070147
  236.       LOOP UNTIL DetectedRing% > 0                                   ' JR070148
  237.  
  238.       RingStarted! = TIMER                                           ' JR070149
  239.       ptimeout! = TIMER                                              ' JR070150
  240.       DO                                                             ' JR070151
  241.          DetectedRing% = INP(ZModemStatusReg) AND &H40               ' JR070152
  242.          ptimeend! = TIMER                                           ' JR070153
  243.          IF ptimeend! - ptimeout! > 5 THEN                           ' JR070154
  244.             LOCATE 20, 36                                            ' JR070155
  245.             PRINT "             "                                    ' JR070156
  246.             EXIT SUB                                                 ' JR070157
  247.          END IF                                                      ' JR070158
  248.       LOOP UNTIL DetectedRing% = 0                                   ' JR070159
  249.  
  250.       RingStopped! = TIMER                                           ' JR070160
  251.       RingLength! = RingStopped! - RingStarted!                      ' JR070161
  252.  
  253.          IF Sreg% = 253 THEN                                         ' JR070162
  254.    ' Telephone Ring = Regular Ring...                                ' JR070163
  255.             IF RingLength! > 1.5 THEN                                ' JR070164
  256.                PAnswer% = 1                                          ' JR070165
  257.             END IF                                                   ' JR070166
  258.    ' Telephone Ring = Short Ring...                                  ' JR070167
  259.          ELSEIF Sreg% = 252 THEN                                     ' JR070168
  260.             IF RingLength! < 1.3 THEN                                ' JR070169
  261.                PAnswer% = 1                                          ' JR070170
  262.             END IF                                                   ' JR070171
  263.          END IF                                                      ' JR070172
  264.  
  265.       LOCATE 20, 36                                                  ' JR070173
  266.       PRINT "             "                                          ' JR070174
  267.  
  268. END SUB                                                              ' JR070175
  269.